;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;icons-dialog-items.lisp
;;
;;  copyright © 1987-89 Apple Computer
;;
;;
;;  this file defines icon-dialog-items which work like buttons.
;;
;;


(eval-when (eval compile)
  (require 'traps))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;first a couple of functions for reading icons from resources
;;  displaying them in a window
;;



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;get-icon
;;
;;given an the number of an icon resource, it attempts to permanently load
;; the icon.  If it succeeds, it returns the icon, otherwise it returns nil.
;;

(defun get-icon (icon-number)
  (without-interrupts
   (let ((icon-holder (_geticon :word icon-number :ptr)))
                                             ;try to get the icon
    (and icon-holder                         ;if we got it
         (_detachresource :ptr icon-holder)) ;make it unpurgeable
     icon-holder)))                          ;and return it


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;plot-icon
;;
;;an object function defined for windows
;;
;;given an icon and a point, it draws the icon at that point
;;
;;icons are always drawn at the standard 32 by 32 size, though the
;;  the toolbox allow scaling to arbitrary sizes.
;;

(defobfun (plot-icon *window*) (icon point)
  (declare (object-variable wptr))
  (let ((rtop (point-v point)) (rleft (point-h point)))
    (without-interrupts
     (with-port wptr
       (rlet ((r :rect                         ;allocate a rectangle
                 :top rtop
                 :left rleft
                 :bottom (+ rtop 32)
                 :right (+ rleft 32)))
         (_ploticon :ptr r :ptr icon))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;read in the three icons from system file and bind them to global variables.
;;

(defvar *stop-icon* (get-icon 0))
(defvar *note-icon* (get-icon 1))
(defvar *warn-icon* (get-icon 2))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;*icon-dialog-item*
;;
;;here we define the icon-dialog-item-class
;;


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;*icon-dialog-item*
;;
;;the new class inherits from *user-dialog-item*
;;
;;

(defobject *icon-dialog-item* *user-dialog-item*)


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;exist
;;
;;an added init-list option :icon allows the caller specify which icon to use.
;;  the default is to use the note icon
;;
;;the size of the item is always 32 by 32
;;

(defobfun (exist *icon-dialog-item*) (init-list)
  (have 'my-icon (getf init-list :icon *note-icon*))
                                             ;get the icon from the init-list
                                             ; or use the default
  (usual-exist
   (init-list-default init-list              ;usual-exist with default size
                      :dialog-item-size #@(32 32))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;dialog-item-draw
;;
;;this is the function called by the system whenever it needs to draw the item
;;
;;

(defobfun (dialog-item-draw *icon-dialog-item*) ()
  (declare (object-variable my-icon my-dialog))
  (let* ((icon my-icon)                      ;rebind some instance variables
         (pos (dialog-item-position)))       ; to lexical variables so they
                                             ; can be passed to another object.
    (ask my-dialog (plot-icon icon pos))))   ;ask the owning dialog window
                                             ;to plot the icon.

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;dialog-item-click-event-handler
;;
;;
;;  this function is called whenever the user clicks in the dialog item.  It
;;  is called on mouse-down, not on mouse-up.
;;
;;  the version defined below tracks the mouse, inverting the icon as long
;;  as the mouse is over it.  If the user releases the mouse-button while the
;;  the mouse is over the icon, the icon's dialog-item-action is called.
;;
;;

(defobfun (dialog-item-click-event-handler *icon-dialog-item*) (where)
  (declare (object-variable my-dialog wptr)
           (ignore where))
  (let* ((pos (dialog-item-position))        ;position of the item
         (mtop (point-v pos))                ;the four rectangle
         (mleft (point-h pos))               ;  coordinates of the
         (mbottom (+ mtop 32))               ;  item
         (mright (+ mleft 32))               ;
         (inverted-p nil)                    ;used to track whether the icon
                                             ;  is inverted. will only be true
                                             ;  when the mouse is over the icon
         (item (self)))                      ;the icon object.
    (ask my-dialog                           ;the dialog does all the tracking.
      (with-port wptr                        ;draw in the dialog's grafport.
        (rlet ((temp-rect :rect              ;temporarily allocate a rectangle
                          :top mtop          ;
                          :left mleft        ;
                          :bottom mbottom    ;
                          :right mright))    ;
          (without-interrupts                ;without interrupts for speed.
           (_inverrect :ptr temp-rect)       ;initially invert the icon.
           (setq inverted-p t)               ;
             (loop                           ;loop until the button is released
               (unless (mouse-down-p)        ;
                 (when inverted-p            ;if button released with mouse
                                             ;  over the icon, run the action
                   (ask item (dialog-item-action)))
                 (return-from dialog-item-click-event-handler))
               (if (logbitp 8 (_PtInRect     ;
                               :long (window-mouse-position)
                               :ptr temp-rect
                               :word))       ;is mouse over the icon's rect?
                   (unless inverted-p        ;yes, make sure it's inverted.
                     (_inverrect :ptr temp-rect)
                     (setq inverted-p t))    ;
                   (when inverted-p          ;no, make sure it's not inverted.
                     (_inverrect :ptr temp-rect)
                     (setq inverted-p nil))))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;dialog-item-action
;;
;;  when the user releases the mouse with the cursor over the icon,
;;  dialog-item-click-event-handler leaves the icon high-lighted and calls
;;  dialog-item-action.  For this reason, the usual-dialog-item-action
;;  redraws the icon to un-invert it.
;;

(defobfun (dialog-item-action *icon-dialog-item*) ()
  (dialog-item-draw))


(provide 'icon-dialog-items)


#|
;;a sample call

(oneof *dialog*
       :window-size #@(115 43)
       :window-title "Icons"
       :window-position #@(150 125)
       :window-type :document
       :dialog-items
       (list
        (oneof *icon-dialog-item*
               :dialog-item-action '(progn
                                      (print "please note")
                                      (ed-beep)
                                      (usual-dialog-item-action)))
        (oneof *icon-dialog-item*
               :icon *stop-icon*
               :dialog-item-action '(progn
                                      (print "please stop")
                                      (ed-beep)
                                      (ed-beep)
                                      (usual-dialog-item-action)))
        (oneof *icon-dialog-item*
               :icon *warn-icon*
               :dialog-item-action '(progn
                                      (print "warning!  warning!")
                                      (ed-beep)
                                      (ed-beep)
                                      (ed-beep)
                                      (usual-dialog-item-action)))))



|#
